home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-04
/
amsf20.zip
/
AMST5.FOR
< prev
next >
Wrap
Text File
|
1992-01-06
|
2KB
|
67 lines
PROGRAM T3
IMPLICIT INTEGER*4 (I-N)
C
C ... TEST AMS GET/SAVE SUBROUTINES
C
COMMON MAVAIL,IA(50000)
LOGICAL ERROR
MAVAIL = 50000
WRITE(6,1) 'OPEN DATA BASE ...'
1 FORMAT(1X,A)
NV = 10
NSIZE = 100
CALL DBOPEN(1,'T3.DAT','NEW')
WRITE(6,1) 'DEFINE MATRIX ...'
CALL DEFINE(1,'AXYZ',NV,0,NSIZE,1,0,L1)
WRITE(6,1) 'WRITE DATA TO DISK ...'
DO 20 J=NV,1,-1
DO 10 I=0,NSIZE-1
10 IA(L1+I) = (J-1)*NSIZE + I + 1
CALL SAVE(1,'AXYZ',J)
20 CONTINUE
K = 0
ERROR = .FALSE.
WRITE(6,1) 'READ DATA BACK ...'
DO 50 J=1,NV
CALL GET(1,'AXYZ',J,L1)
DO 30 I=0,NSIZE-1
K = K + 1
30 IF (K.NE.IA(L1+I)) ERROR = .TRUE.
50 CONTINUE
IF (ERROR) THEN
WRITE(6,100)
ELSE
WRITE(6,110)
END IF
C ... TEST DB ASCII CONVERSION
WRITE(6,1) 'TEST DB FILE TO TEXT FILE CONVERSION ...'
CALL DB2TXT(1,'T3.ASC')
C ... NOW CREATE A NEW DATABASE 2
CALL DBOPEN(2,'T3.DT2','NEW')
C ... TEST ASCII DB CONVERSION
WRITE(6,1) 'TEST TXT FILE TO DB FILE CONVERSION ...'
CALL TXT2DB('T3.ASC',2)
C ... TEST FOR CORRECTNESS
ERROR = .FALSE.
DO 80 J=1,NV
CALL GET(1,'AXYZ',J,L1)
CALL GET(2,'AXYZ',J,L2)
DO 70 I=0,NSIZE-1
IF (IA(L1+I).NE.IA(L2+I)) ERROR = .TRUE.
70 CONTINUE
80 CONTINUE
IF (ERROR) THEN
WRITE(6,120)
ELSE
WRITE(6,130)
END IF
WRITE(6,1) 'CLOSE DATA BASE, AND DELETE IT ...'
CALL DBCLOS(2,'DELETE')
CALL DBCLOS(1,'DELETE')
100 FORMAT(1X,'AMS GET/SAVE ERROR.')
110 FORMAT(1X,'AMS GET/SAVE TEST OK.')
120 FORMAT(1X,'AMS DB2TXT/TXT2DB ERROR.')
130 FORMAT(1X,'AMS DB2TXT/TXT2DB TEST OK.')
STOP 'DONE.'
END